home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Camelot / Camelot 098 (1990-12)(Swedish User Group of Amiga)(SE)(PD)[WB].zip / Camelot 098 (1990-12)(Swedish User Group of Amiga)(SE)(PD)[WB].adf / XLisp-Stat / Book / editcursor.lsp < prev    next >
Text File  |  1990-10-11  |  1KB  |  30 lines
  1. ; book pp.259-260
  2.  
  3. (require "functions/bitmapedit")
  4.  
  5. (setf w (send bitmap-edit-proto :new 16 16))
  6. (send w :title "Cursor Editor")
  7.  
  8. (defmeth bitmap-edit-proto :name-bitmap ()
  9.   (let ((str (get-string-dialog "Symbol for the bitmap:")))
  10.     (if str
  11.         (let ((name (with-input-from-string (s str) (read s))))
  12.           (setf (symbol-value name) (send self :bitmap))))))
  13. (defmeth bitmap-edit-proto :bitmap-as-cursor (yes)
  14.   (if yes (make-cursor 'temp-cursor (send self :bitmap)))
  15.   (send self :cursor (if yes 'temp-cursor 'arrow)))
  16.  
  17. (setf bitmenu (send menu-proto :new "Bitmap"))
  18. (setf name-item
  19.   (send menu-item-proto :new "Name Bitmap..."
  20.     :action #'(lambda () (send w :name-bitmap))))
  21. (setf cursor-item
  22.   (send menu-item-proto :new "Use as Cursor"
  23.     :action #'(lambda ()
  24.        (let ((mark (send cursor-item :mark)))
  25.              (send w :bitmap-as-cursor (not mark))
  26.              (send cursor-item :mark (not mark))))))
  27. (send bitmenu :append-items name-item cursor-item)
  28. (send w :menu bitmenu)
  29. (send bitmenu :install)
  30.